home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / art&graf.ix / art-6205 / morphing / util / grille.lst < prev   
File List  |  1996-08-09  |  3KB  |  132 lines
  1. ' **************************************
  2. ' **  Calcul de grille déformé
  3. ' **  GFA Basic
  4. ' **
  5. ' **  Valvassori Moïse 07.96
  6. ' **************************************
  7. '
  8. w=319   ! taille de la grille
  9. h=199
  10. c=20    ! nombre de ligne marge comprise
  11. l=20
  12. nom_grille$="GRILLE.GRD"
  13. DIM gx%(c,l),gy%(c,l)   ! grille d'arrivé
  14. DIM gx1%(c,l),gy1%(c,l) ! grille de départ
  15. init
  16. trace
  17. '
  18. calcul
  19. '
  20. verif
  21. trace
  22. sauve
  23. PROCEDURE calcul
  24.   ' Une première méthode de calcul
  25.   LOCAL x,y
  26.   FOR x=0 TO c-1
  27.     FOR y=0 TO l-1
  28.       IF x<>0 AND x<>c-1        ! on déforme pas les bords
  29.         gx%(x,y)=gx%(x,y)+50*(COS(y*(1*PI)/l-1)*SIN(x*(2.5*PI)/(c-1)))
  30.       ENDIF
  31.       IF y<>0 AND y<>l-1        ! on déforme pas les bords
  32.         gy%(x,y)=gy%(x,y)+50*(COS(x*(3*PI)/(c-1))*SIN(y*PI/(l-1)))
  33.       ENDIF
  34.     NEXT y
  35.   NEXT x
  36. RETURN
  37. PROCEDURE calcul1
  38.   ' Une seconde...
  39.   ' Pour l'utiliser remplacer 'calcul' par 'calcul1'
  40.   LOCAL x,y,vx,vy,d,a,b,dm
  41.   a=w/2
  42.   b=h/2
  43.   dm=SQR(a^2+b^2)
  44.   FOR x=0 TO c-1
  45.     FOR y=0 TO l-1
  46.       vx=gx%(x,y)-a
  47.       vy=gy%(x,y)-b
  48.       d=SQR(vx^2+vy^2)
  49.       IF x<>0 AND x<>c-1        ! on déforme pas les bords
  50.         gx%(x,y)=a+vx*1.6*SIN((d/dm)*PI)
  51.       ENDIF
  52.       IF y<>0 AND y<>l-1        ! on déforme pas les bords
  53.         gy%(x,y)=b+vy*1*SIN(d/dm*PI)
  54.       ENDIF
  55.     NEXT y
  56.   NEXT x
  57. RETURN
  58. PROCEDURE init
  59.   LOCAL x,y
  60.   FOR x=0 TO c-1
  61.     FOR y=0 TO l-1
  62.       gx%(x,y)=(x*w/(c-1))+1        ! des grilles bien régulières
  63.       gy%(x,y)=y*h/(l-1)
  64.       gx1%(x,y)=(x*w/(c-1))+1       ! ()+1 au cause du bug du bord gauche
  65.       gy1%(x,y)=y*h/(l-1)
  66.     NEXT y
  67.   NEXT x
  68. RETURN
  69. PROCEDURE trace
  70.   ' trace que la grille d'arrivé
  71.   LOCAL x,y
  72.   CLS
  73.   FOR x=0 TO c-1
  74.     FOR y=0 TO l-1
  75.       IF x<>c-1
  76.         COLOR (y MOD 15)+1
  77.         DRAW gx%(x,y),gy%(x,y) TO gx%(x+1,y),gy%(x+1,y)
  78.       ENDIF
  79.       IF y<>l-1
  80.         COLOR (x MOD 15)+1
  81.         DRAW gx%(x,y),gy%(x,y) TO gx%(x,y+1),gy%(x,y+1)
  82.       ENDIF
  83.     NEXT y
  84.   NEXT x
  85. RETURN
  86. PROCEDURE verif
  87.   ' Vérifie si l'on est pas sortie du cadre
  88.   LOCAL x,y
  89.   FOR x=0 TO c-1
  90.     FOR y=0 TO l-1
  91.       IF gx%(x,y)<1     ! gère le bug du bord gauche de la grille
  92.         gx%(x,y)=1
  93.       ENDIF
  94.       IF gy%(x,y)<0
  95.         gy%(x,y)=0
  96.       ENDIF
  97.       IF gx%(x,y)>w+1   ! bug du bors gauche
  98.         gx%(x,y)=w+1
  99.       ENDIF
  100.       IF gy%(x,y)>h
  101.         gy%(x,y)=h
  102.       ENDIF
  103.     NEXT y
  104.   NEXT x
  105. RETURN
  106. PROCEDURE sauve
  107.   LOCAL x,y
  108.   OPEN "o",#1,nom_grille$      ! nom du fichier
  109.   ' header
  110.   PRINT #1;"MORPHING GRID";CHR$(0);     ! type de fichier
  111.   PRINT #1;MKI$(&H100);                 ! version 1.00
  112.   ' GRILLE grid 0
  113.   PRINT #1;MKI$(c-1);MKI$(l-1);MKI$(gx1%(0,0));MKI$(gy1%(0,0)); ! nb de colone,nb de ligne, coin haut et gauche
  114.   PRINT #1;MKI$(gx1%(c-1,l-1));MKI$(gy1%(c-1,l-1));"dumy";      ! coin bas et droit, pointeur sur la grille (dummy)
  115.   ' GRILLE grid 1
  116.   PRINT #1;MKI$(c-1);MKI$(l-1);MKI$(gx%(0,0));MKI$(gy%(0,0));
  117.   PRINT #1;MKI$(gx%(c-1,l-1));MKI$(gy%(c-1,l-1));"dumy";
  118.   ' data grid 0
  119.   FOR y=0 TO l-1
  120.     FOR x=0 TO c-1
  121.       PRINT #1;MKI$(gx1%(x,y));MKI$(gy1%(x,y)); ! les données de la grille
  122.     NEXT x
  123.   NEXT y
  124.   ' data grid 1
  125.   FOR y=0 TO l-1
  126.     FOR x=0 TO c-1
  127.       PRINT #1;MKI$(gx%(x,y));MKI$(gy%(x,y));
  128.     NEXT x
  129.   NEXT y
  130.   CLOSE #1
  131. RETURN
  132.